﻿module WebServer

// This module implements AwaitTask for non generic Task
// It should be useless in F# 4 since it should be implemented in FSharp.Core
[<AutoOpen>]
module AsyncExtensions =
    open System
    open System.Threading
    open System.Threading.Tasks
    type Microsoft.FSharp.Control.Async with
        static member Raise(ex) = Async.FromContinuations(fun (_,econt,_) -> econt ex)

        static member AwaitTask (t: Task) =
            let tcs = new TaskCompletionSource<unit>(TaskContinuationOptions.None)
            t.ContinueWith((fun _ -> 
                if t.IsFaulted then tcs.SetException t.Exception
                elif t.IsCanceled then tcs.SetCanceled()
                else tcs.SetResult(())), TaskContinuationOptions.ExecuteSynchronously) |> ignore
            async {
                try
                    do! Async.AwaitTask tcs.Task
                with
                | :? AggregateException as ex -> 
                    do! Async.Raise (ex.Flatten().InnerExceptions |> Seq.head) }



open System.Net
open System.IO
open Microsoft.FSharp.Control

let server handler  = 
    let listener = new HttpListener(IgnoreWriteExceptions = true )
    listener.Prefixes.Add("http://localhost:80/")

    listener.Start()

    let rec listen() =
        async {
                let! context = Async.AwaitTask <| listener.GetContextAsync()
                match handler context with
                | Some p -> Async.Start p
                | None -> context.Response.StatusCode <- 404
                          context.Response.Close()
                return! listen() }

    listen()
    |> Async.Start
    listener

let url path webPart (context: HttpListenerContext) =
    if context.Request.Url.LocalPath = path then
        webPart context
    else
        None


type WebPart = HttpListenerContext -> Async<unit> option
let methOd m (webPart: WebPart) (context: HttpListenerContext) =
    if context.Request.HttpMethod = m then
        webPart context
    else
        None

let GET  = methOd "GET"
let POST = methOd "POST" 

let text s (context: HttpListenerContext) =
            async {
                context.Response.ContentType <- "text/plain"
                use writer = new StreamWriter(context.Response.OutputStream)
                do! Async.AwaitTask(writer.WriteLineAsync (s: string))
                do! Async.AwaitTask(writer.FlushAsync())
                context.Response.Close() }
            |> Some

let choose parts context =
    parts
    |> List.tryPick (fun part -> part context)    


[<EntryPoint>]
let main argv = 

    let s = server <| choose [GET (url "/hello" (text "Hello World")) 
                              GET (url "/world" (text "World")) ]

    System.Console.ReadLine() |> ignore

    1